home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / hm--html-menus / hm--html-drag-and-drop.el.z / hm--html-drag-and-drop.el
Encoding:
Text File  |  1998-05-21  |  6.4 KB  |  168 lines
  1. ;;; $Id: hm--html-drag-and-drop.el,v 1.5 1997/02/12 00:21:03 muenkel Exp $
  2. ;;; 
  3. ;;; Copyright (C) 1996, 1997 Heiko Muenkel
  4. ;;; email: muenkel@tnt.uni-hannover.de
  5. ;;;
  6. ;;;  This program is free software; you can redistribute it and/or modify
  7. ;;;  it under the terms of the GNU General Public License as published by
  8. ;;;  the Free Software Foundation; either version 1, or (at your option)
  9. ;;;  any later version.
  10. ;;;
  11. ;;;  This program is distributed in the hope that it will be useful,
  12. ;;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;;;  GNU General Public License for more details.
  15. ;;;
  16. ;;;  You should have received a copy of the GNU General Public License
  17. ;;;  along with this program; if not, write to the Free Software
  18. ;;;  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19. ;;;
  20. ;;; 
  21. ;;; Description:
  22. ;;;
  23. ;;;    This package contains functions to insert links and other
  24. ;;;    HTML stuff with the mouse with drag and drop.
  25. ;;;
  26. ;;;    For further descriptions look at the file 
  27. ;;;    internal-drag-and-drop.el, which implements the basic (and
  28. ;;;    more genreal functions) for the drag and drop interface.
  29. ;;; 
  30. ;;; Installation: 
  31. ;;;   
  32. ;;;    Put this file in your load path.
  33. ;;;
  34.  
  35. (require 'internal-drag-and-drop)
  36. (require 'cl)
  37.  
  38. ;(defun hm--html-first-non-matching-position (string1 string2)
  39. ;  "Compares both strings and returns the first position, which is not equal."
  40. ;  (let ((n 0)
  41. ;    (max-n (min (length string1) (length string2)))
  42. ;    (continue t))
  43. ;    (while (and continue (< n max-n))
  44. ;      (when (setq continue (= (aref string1 n) (aref string2 n)))
  45. ;    (setq n (1+ n))))
  46. ;    n))
  47.  
  48. ;(defun hm--html-count-subdirs (directory)
  49. ;  "Returns the number of subdirectories of DIRECTORY."
  50. ;  (let ((n 0)
  51. ;    (max-n (1- (length directory)))
  52. ;    (count 0))
  53. ;    (while (< n max-n)
  54. ;      (when (= ?/ (aref directory n))
  55. ;    (setq count (1+ count)))
  56. ;      (setq n (1+ n)))
  57. ;    (when (and (not (= 0 (length directory)))
  58. ;           (not (= ?/ (aref directory 0))))
  59. ;      (setq count (1+ count)))
  60. ;    count))
  61.  
  62. ;(defun hm--html-return-n-backwards (n)
  63. ;  "Returns a string with N ../"
  64. ;  (cond ((= n 0) "")
  65. ;    (t (concat "../" (hm--html-return-n-backwards (1- n))))))
  66.  
  67. ;(defun* hm--html-file-relative-name (file-name 
  68. ;                     &optional (directory default-directory))
  69. ;  "Convert FILENAME to be relative to DIRECTORY (default: default-directory)."
  70. ;  (let* ((pos (hm--html-first-non-matching-position file-name directory))
  71. ;     (backwards (hm--html-count-subdirs (substring directory pos)))
  72. ;     (relative-name (concat (hm--html-return-n-backwards backwards)
  73. ;                (substring file-name pos))))
  74. ;    (if (= 0 (length relative-name))
  75. ;    "./"
  76. ;      (if (= ?/ (aref relative-name 0))
  77. ;      (if (= 1 (length relative-name))
  78. ;          "./"
  79. ;        (substring relative-name 1))
  80. ;    relative-name))))
  81.  
  82. (defun hm--html-idd-add-include-image-from-dired-line (source destination)
  83.   "Inserts an include image tag at the DESTINATION.
  84. The name of the image is on a line in a dired buffer. It is specified by the
  85. SOURCE."
  86.   (idd-set-point destination)
  87.   (if hm--html-idd-create-relative-links
  88.       (hm--html-add-image-top (file-relative-name
  89.                    (idd-get-dired-filename-from-line source))
  90.                   (file-name-nondirectory
  91.                    (idd-get-dired-filename-from-line source)))
  92.     (hm--html-add-image-top (idd-get-dired-filename-from-line source)
  93.                 (file-name-nondirectory
  94.                  (idd-get-dired-filename-from-line source)))))
  95.  
  96. (defun hm--html-idd-add-link-to-region (link-object destination)
  97.   "Inserts a link with the LINK-OBJECT in the DESTINATION.
  98. It uses the region as the name of the link."
  99.   (idd-set-region destination)
  100.   (hm--html-add-normal-link-to-region link-object)
  101.   )
  102.  
  103. (defun hm--html-idd-add-link (link-object destination)
  104.   "Inserts a link with the LINK-OBJECT in the DESTINATION."
  105.   (idd-set-point destination)
  106.   (hm--html-add-normal-link link-object))
  107.     
  108. (defun hm--html-idd-add-link-to-point-or-region (link-object destination)
  109.   "Inserts a link with the LINK-OBJECT in the DESTINATION.
  110. It uses the region as the name of the link, if the region was active
  111. in the DESTINATION."
  112.   (if (cdr (assoc ':region-active destination))
  113.       (hm--html-idd-add-link-to-region link-object destination)
  114.     (hm--html-idd-add-link link-object destination)))
  115.  
  116. (defun hm--html-idd-add-file-link-to-file-on-dired-line (source destination)
  117.   "Inserts a file link in DESTINATION to the file on the dired line of SOURCE."
  118.   (idd-set-point destination)
  119.   (if hm--html-idd-create-relative-links
  120.       (hm--html-idd-add-link-to-point-or-region
  121.        (file-relative-name
  122.     (idd-get-dired-filename-from-line source))
  123.        destination)
  124.     (hm--html-idd-add-link-to-point-or-region
  125.      (concat "file://" (idd-get-dired-filename-from-line source))
  126.      destination)))
  127.  
  128. (defun hm--html-idd-add-file-link-to-buffer (source destination)
  129.   "Inserts a file link at DESTINATION to the file of the SOURCE buffer."
  130.   (idd-set-point destination)
  131.   (if hm--html-idd-create-relative-links
  132.       (hm--html-idd-add-link-to-point-or-region
  133.        (file-relative-name (idd-get-local-filename source))
  134.        destination)
  135.     (hm--html-idd-add-link-to-point-or-region
  136.      (concat "file://" (idd-get-local-filename source))
  137.      destination)))
  138.  
  139. (defun hm--html-idd-add-file-link-to-directory-of-buffer (source
  140.                               destination)
  141.   "Inserts a file link at DESTINATION to the directory of the SOURCE buffer."
  142.   (idd-set-point destination)
  143.   (if hm--html-idd-create-relative-links
  144.       (hm--html-idd-add-link-to-point-or-region
  145.        (file-relative-name (idd-get-directory-of-buffer source))
  146.        destination)
  147.     (hm--html-idd-add-link-to-point-or-region
  148.      (concat "file://" (idd-get-directory-of-buffer source))
  149.      destination)))
  150.  
  151. (defun hm--html-idd-add-html-link-to-w3-buffer (source destination)
  152.   "Inserts a link at DESTINATION to the w3 buffer specified by the SOURCE.
  153. Note: Relative links are currently not supported for this function."
  154.   (idd-set-point destination)
  155.   (hm--html-idd-add-link-to-point-or-region (idd-get-buffer-url source)
  156.                         destination))
  157.  
  158. (defun hm--html-idd-add-html-link-from-w3-buffer-point (source destination)
  159.   "Inserts a link at DESTINATION to a lin in the w3 buffer.
  160. The link in the w3-buffer is specified by the SOURCE.
  161. Note: Relative links are currently not supported for this function."
  162.   (idd-set-point destination)
  163.   (hm--html-idd-add-link-to-point-or-region (idd-get-url-at-point source)
  164.                         destination))
  165.  
  166. ;;; Announce the feature hm--html-drag-and-drop
  167. (provide 'hm--html-drag-and-drop)
  168.